home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Mops 2.7 / Mops source / Toolbox classes / serial < prev    next >
Encoding:
Text File  |  1995-08-24  |  3.5 KB  |  134 lines  |  [TEXT/MSET]
  1. \ serial - async serial driver support
  2. \  2/04/85  cbd Version 1
  3. \  9/04/86  cdn Eliminated redundant readnw: & writenw
  4. \  9/06/86  cdn Added bi-directional port usage
  5. \                Automatically send reset: in open:
  6. \  4/19/89    rfl    added break:
  7. \  6/13/89    rfl requires interval for pause
  8. \  3/14/90    rfl    added buffer:
  9. \  8/16/90    rfl    added baudrate: and XON:
  10.  
  11. \ May 93    mrh Mops version.
  12.  
  13. need drvr
  14.  
  15. decimal
  16.  
  17. \ define serial i/o port object
  18.  
  19. :class  PORT  super{ PBDrvr }
  20. record
  21. {    int        thePort            \  0=modem, 1=printer
  22.     int        Direction        \  0=input, 1=output, 2=both
  23.     int        Config            \ bits, parity, speed
  24.     int        inRef            \ input IORefNum
  25.     int        outRef            \ output IORefNum
  26. }
  27.  
  28. :m INIT:    \ ( port# direction -- )
  29.     put: direction   put: thePort  ;m
  30.  
  31. :m SETCONFIG:        \ ( config -- )  Set the config word directly
  32.     put: config  ;m
  33.  
  34.  
  35. :m CONFIG:  { stop data parity -- }
  36.         \ Sets stop, data bits in the config word
  37.         \ stop can be 1 or 2
  38.         \ data can be 7 or 8
  39.         \ parity: 0=none 1=odd 2=even
  40.  
  41.     data 7 =
  42.     IF $ 400  ELSE $ C00  THEN  -> data
  43.     stop 1 =
  44.     IF $ 4000 ELSE $ C000 THEN  -> stop
  45.     parity
  46.     NIF        $ 2000
  47.     ELSE    parity 1 =
  48.             IF    $ 1000
  49.             ELSE  $ 3000
  50.             THEN
  51.     THEN  -> parity
  52.     get: config  $ 01FF and  data or  stop or  parity or
  53.     put: config  ;m
  54.  
  55.  
  56. :m BAUD:    \ ( n -- )  Sets the baud rate for the port
  57.             \            - 300,600,1200,2400, etc.
  58.     dup 300 =
  59.     IF    80 +
  60.     ELSE  300 /  380 swap /  1-
  61.     THEN  get: config  $ FE00 and  or  put: config  ;m
  62.  
  63.  
  64. :m CONTROL:        \ Does PBControl call
  65.     get: direction  dup 0=  swap 2 = or
  66.     IF    get: inRef  put: IORefNum  addr: header  call PBControlSync  THEN
  67.     get: direction
  68.     IF    get: outRef put: IORefNum  addr: header  call PBControlSync  THEN
  69. ;m
  70.  
  71.  
  72. :m RESET:        \ Sets the communication parms from the configuration word
  73.     8 put: csCode  get: config  put: csp1  0 put: IOComp
  74.     control: self  ;m
  75.  
  76.  
  77. :m OPN:        \ ( addr len -- RefNum )
  78.     name: super  open: super drop  get: IORefNum  ;m
  79.  
  80.  
  81. :m OPEN:    \ ( -- )  Opens the read and write drivers for a port
  82.     get: thePort
  83.     NIF    get: direction  dup 0=  swap 2 =  or
  84.         IF  " .AIn"  opn: self put: inRef  THEN
  85.         get: direction
  86.         IF  " .AOut" opn: self put: outRef  THEN
  87.     ELSE  get: direction  dup 0=  swap 2 = or
  88.         IF  " .BIn"  opn: self put: inRef  THEN
  89.         get: direction
  90.         IF  " .BOut" opn: self put: outRef THEN
  91.     THEN
  92.     get: IOResult  reset: self  ;m
  93.  
  94.  
  95. :m READ:    \ ( addr len -- fcode )  receive LEN bytes on the serial port
  96.     0 put: IOComp  get: inRef  put: IORefNum  read: super  ;m
  97.  
  98. :m WRITE:    \ ( addr len -- fcode )  send LEN bytes on the serial port
  99.     0 put: IOComp  get: outRef  put: IORefNum  write: super  ;m
  100.  
  101. :m READNW:    \ ( cfa:proc addr len )  receive LEN bytes asynchronously on the port
  102.     get: inRef  put: IORefNum  readnw: super  ;m
  103.  
  104. :m WRITENW:    \ ( cfa:proc addr len )  send LEN bytes asynchronously on the port
  105.     get: outRef  put: IORefNum  writenw: super  ;m
  106.  
  107. :m GET:        \ ( -- char )  get a single character from port
  108.     pad 1  read: self drop  pad c@  ;m
  109.  
  110. :m PUT:        \ ( char -- )  send a single char to port
  111.     pad c!  pad 1 write: self  drop  ;m
  112.  
  113. :m CTS:        \ ( bool -- fcode )  turn CTS handshaking on or off via CONTROL call
  114.     addr: csp1  10 erase  put: csp1  10 put: csCode  0 put: IOComp
  115.     control: self  get: IOResult  ;m
  116.  
  117.  
  118. :m XON: ( -- )
  119.     10 put: cscode $ 01001113 addr: csP1 ! control: self  ;m
  120.  
  121. :m BREAK:        \ sends out a 100 msec break
  122.     12 put: csCode control: self  6 pause  11 put: csCode  control: self  ;m
  123.  
  124. :m BUFFER:     \ ( addr len -- ) increase internal buffer size from default
  125.             \                    of 64 bytes
  126.     addr: IOBuffer w!  addr: csP1 !  9 put: cscode
  127.     control: self  ;m
  128.  
  129.  
  130. :m BAUDRATE: ( n --)
  131.     13 put: cscode  put: csP1  control: self  ;m
  132.  
  133. ;class
  134.